          SUBROUTINE (INIT.BR,PN)
** Version# 46.0001[6] - 08/25/2016 - 10:12am - TSMITH - eclipse
*** V46.0001 Change - Custom Coding . - 08/25/2016 - TSMITH - eclipse

*** SUBROUTINE: PRODUCT.LEDGER
*-------------------------------------------------------------------------*
** EJO 06/18/2000 Future Ledger Inquiry - displays all committments for
**                                        specified product.
*-------------------------------------------------------------------------*
** Variables:
**        INIT.BR     Branch#                (In)
**        PN          Eclipse Product ID     (In)
*-------------------------------------------------------------------------*
*** COMMON VARIABLES:
***       STK.TYPES.AVL$ - 'SE'
*-------------------------------------------------------------------------*
          WINDOW ,,,,9,'PRODUCT.LEDGER'
          SBRS = ''
          IN.BR.CHANGE = NO
          GOSUB INIT

          VSCROLL.DEFINE 1,1,7,78,10,'PRODUCT.LEDGER'
          VSCROLL.SET 1

          * If there are multi values then it was called to automatically
          * view bids only.
          BID.FLAG = NO
          IF DCOUNT(INIT.BR, VM) > 1 THEN
             INIT.BR  = INIT.BR<1,1>
             BID.FLAG = YES
          END

          BR          = INIT.BR
          TYPE.FILTER = ''
          BID.MODE    = NO
          SHOW.PRI    = NO

          ID.BASE = 2; STK.BASE = 3
          MATREAD PRD  FROM PRDFILE,PN      ELSE MAT PRD = ''
          MATREAD PLNE FROM PLNEFILE,PRD(9) ELSE MAT PLNE = ''
          DFLT.PER.GET 'I',PER,UM
          DESC = PRD(1)

          IF BID.FLAG = YES THEN GOSUB SHOW.BIDS

          GOSUB SORT.DATE
REDISP:   GOSUB DISPLAY

          IF BLANK THEN
             MENU.CLEAR
             MENU.LOAD  2,18, 9,1,'S'
             MENU.LOAD ,,,,''
             MENU.LOAD ,,,,''
             MENU.LOAD 31,18, 7,6,'B'
             MENU.LOAD 63,18, 9,1,'C'
             PRINT BELL:
MESS.INP:    MESS 2,7,'No items found. Re-select or press <Esc> to exit...'
IN$$6:       INP A,0,0,0
             IF QUIT THEN GOTO FINISH
             GOTO MESS.INP
          END

          MENU.CLEAR
          MENU.LOAD  2,18, 9,1,'S'
          MENU.LOAD 14,18, 8,1,'V'
          *** If product is a lotitem, restrict access to location maint
          IF PRD(3) # 9 THEN
             MENU.LOAD 25,18, 3,1,'L'
          END ELSE
             MENU.LOAD ,,,,
          END
          MENU.LOAD 31,18, 7,6,'B'
          MENU.LOAD 41,18, 7,1,'I'
          MENU.LOAD 51,18, 9,1,'H'
          MENU.LOAD 63,18, 9,1,'C'
          MENU.LOAD 75,18, 3,3,'G'

          LINE = 1; COL = 1
*-------------------------------------------------------------------------*
MOVENEXT: PARSEMOVE COL,LINE,1,LN.CT,10,YES,NO

IN$$1:    INPV A,0,LINE,0
          IF QUIT THEN GOTO FINISH

          GOTO MOVENEXT
*-------------------------------------------------------------------------*
LOAD.VIEW:*** Displays the lines and column heading for the current view.

          LNS = '                         '
          BEGIN CASE
          CASE VIEW.NO = 1
             HDG  = 'InOutAvailCustomer/Vendor'
             LNS := '                                             '
             FTG  = ''
          CASE OTHERWISE
             HDG  = 'In/OutCustomer P/OCustomer/Vendor'
             LNS := '                                              '
             FTG  = ''
          END CASE

          PRINT @(30, 6):HDG:
          FOR J = 1 TO 10
             PRINT @(1,6+J):LNS:
          NEXT J
          PRINT @(30,17):FTG:

          RETURN
*-------------------------------------------------------------------------*
DISPLAY:  PRINT @(2,1):DESC<1,1>    "L#35"
          PRINT @(2,2):DESC<1,2>    "L#35"
          PRINT @(2,3):DESC<1,3>    "L#35"
          PRINT @(41,0):BR          "R#4"

          IF NOT(SUPR.AVAILS) THEN GOSUB DISP.TOTALS

          IF BID.MODE THEN
             PRINT @(2,6):'':BLINK$:'Bid #':NORM$:''
          END ELSE
             PRINT @(2,6):'Order #'
          END

          GOSUB LOAD.VIEW

          SEL.IDS = ''
          LINE = 1
          VSCROLL.MOVE LINE
          IF NOT(SUPR.AVAILS) THEN AVAIL = STK.OH / PER
          LN.CT = 0
          MORE.DATA = (IDS#'')
          IF NOT(MORE.DATA) THEN BLANK = YES; ELSE BLANK = NO
          LOOP UNTIL NOT(MORE.DATA)
             REMOVE ID  FROM IDS  SETTING MORE.DATA
             REMOVE QTY FROM QTYS SETTING X
             REMOVE SBR FROM SBRS SETTING Y
             IF SBR = '' THEN SBR = BR
             PRI.DT  = FIELD(ID,'~',1)
             SHP.DAT = FIELD(ID,'~',2)+0
             OID     = FIELD(ID,'~',3)
             LDID    = FIELD(ID,'~',4)
             GID     = FIELD(ID,'~',5)
             TYPE    = FIELD(ID,'~',6)
             QTY     = QTY / PER
             GOSUB DISP.LN
          REPEAT

          VCLR LINE
          LN.CT = LINE - 1

          RETURN
*-------------------------------------------------------------------------*
DISP.LN:  *
          READ LREC FROM LEDFILE,OID ELSE LREC = ''
          WK.TYPE = TYPE[1,1]
          BEGIN CASE
          CASE WK.TYPE = 'S' AND LEN(TYPE)>1;    TYPD = 'VCnsgn'
          CASE WK.TYPE = 'S' AND LREC<110>='S';  TYPD = 'CCsnTr'
          CASE WK.TYPE = 'S';                    TYPD = 'Stock'
          CASE WK.TYPE = 'F';                    TYPD = 'Defctv'
          CASE WK.TYPE = 'T';                    TYPD = 'Tagged'
          CASE WK.TYPE = 'O';                    TYPD = 'Ovrshp'
          CASE WK.TYPE = 'P';                    TYPD = 'Procur'
          CASE WK.TYPE = 'D';                    TYPD = 'Direct'
          CASE WK.TYPE = 'B';                    TYPD = 'Br Dir'
          CASE WK.TYPE = 'R';                    TYPD = 'Review'
          CASE WK.TYPE = 'E';                    TYPD = 'Except'
          CASE WK.TYPE = 'C';                    TYPD = 'CCsnBi'
          CASE WK.TYPE = 'L';                    TYPD = 'Displa'
          CASE WK.TYPE = 'N';                    TYPD = 'ResINV'
          CASE OTHERWISE;                        TYPD = WK.TYPE
          END CASE
          LOCATE GID IN LREC<12> SETTING GEN ELSE GEN = 1
          IF OID[1,1]#'T' THEN ATTB.NO = 5 ELSE
             XBR = LREC<2,GEN,2>
             IF XBR = BR THEN ATTB.NO = 5 ELSE ATTB.NO = 1
          END

          EN = LREC<ATTB.NO,GEN>
          STATUS = LREC<6,GEN>
          IF REMOTE.CUST THEN
             IF EN#REMOTE.CUST THEN RETURN
          END

          SEL.IDS<LINE> = ID
          CRTL.ID = 'HIST.FUT.LEDGER.DISP'
          READ DISP.OPT FROM CTRLFILE,CRTL.ID ELSE DISP.OPT = 'I'
          IF DISP.OPT = 'I' THEN ATTB = 9 ELSE ATTB = 1
          READV NAME FROM ENTFILE,EN,ATTB ELSE NAME = '* Not Found *'
          IF QTY>0 THEN IN=QTY; OUT='' ELSE IN=''; OUT=-QTY
          SHP.DAT.DISP = SHP.DAT
          OE.SHIPDATE.CONV SHP.DAT.DISP

          IF SHOW.PRI THEN
             IF QTY < 0 THEN
                PRI.DATE = PRI.DT[1,5]
                PRI.TIME = PRI.DT[6,5]
             END ELSE
                PRI.DATE = PRI.DT[6,5]
                PRI.TIME = ''
             END
             IF PRI.DATE # 0 THEN
                PRI.DATE = OCONV(PRI.DATE,'D2/')
             END ELSE PRI.DATE = ''
             CUS.VEN  = PRI.DATE "L#8":'-':OCONV(PRI.TIME,'MT') "L#7"
             CUS.VEN := NAME "L#11"
          END ELSE
             CUS.VEN  = NAME "L#27"
          END

          VPRINT 0,LINE,OID"L#10"
          VPRINT 11,LINE,STATUS"L#1"
          VPRINT 13,LINE,SHP.DAT.DISP"L#8"
          IF SBR # BR THEN TYPD = "Br#":SBR "L#3"
          VPRINT 22,LINE,TYPD"L#6"

          IF VIEW.NO = 1 THEN
             CK.QTY = IN
             CK.SZ  = 6
             * If greater than or equal to 1,000,000 convert to X.XX mil.
             IF IN > 999999 OR (IN # '' AND IN < -999999) THEN
                CK.QTY = UT.CONV.MILL(CK.QTY)
             END ELSE
                GOSUB GET.FMT
                CK.QTY = CK.QTY FMT
             END
             VPRINT 29,LINE,CK.QTY
             CK.QTY = OUT
             CK.SZ  = 6
             * If greater than or equal to 1,000,000 convert to X.XX mil.
             IF OUT > 999999 OR (OUT # '' AND OUT < -999999) THEN
                CK.QTY = UT.CONV.MILL(CK.QTY)
             END ELSE
                GOSUB GET.FMT
                CK.QTY = CK.QTY FMT
             END
             VPRINT 36,LINE,CK.QTY
             IF INDEX(STK.TYPES.AVL$,TYPE[1,1],1) AND NOT(SUPR.AVAILS) THEN
                AVAIL = AVAIL + QTY
                CK.QTY = AVAIL
                CK.SZ  = 7
                *If greater than or equal to 1,000,000 convert to X.XX mil.
                IF CK.QTY > 999999 OR (CK.QTY#'' AND CK.QTY < -999999) THEN
                   CK.QTY = UT.CONV.MILL(CK.QTY)
                END ELSE
                   GOSUB GET.FMT
                   CK.QTY = CK.QTY FMT
                END
                VPRINT 43,LINE,CK.QTY
             END ELSE
                VPRINT 43,LINE,''   "L#7"
             END
             VPRINT 51,LINE,CUS.VEN "L#27"
          END ELSE
             CK.QTY = QTY
             CK.SZ  = 7
             *** If greater than or equal to 1,000,000 convert to X.XX mil.
             IF IN > 999999 OR (IN # '' AND IN < -999999) THEN
                CK.QTY = UT.CONV.MILL(CK.QTY)
             END ELSE
                GOSUB GET.FMT
                CK.QTY = CK.QTY FMT
             END
             VPRINT 29,LINE,CK.QTY "R#7"
             VPRINT 37,LINE,LREC<13,GEN> "L#20"
             VPRINT 58,LINE,CUS.VEN "L#20"
          END

          LINE = LINE+1

          RETURN
*-------------------------------------------------------------------------*
DISP.TOTALS:*
          INV.GET.TOTALS PN,BR,STK.OH,TAG.OH,STK.CMTD,TAG.CMTD,STK.PO,TAG.PO,STK.XFER,TAG.XFER,ON.REVW,ON.BID,STK.INPR,TAG.INPR,,STK.WO,TAG.WO
          GOSUB NET.COMMT

          CK.QTY = STK.OH/PER
          CK.SZ  = 7
          *** If greater than or equal to 1,000,000 convert to X.XX mil.
          IF CK.QTY > 999999 OR (CK.QTY # '' AND CK.QTY < -999999) THEN
             CK.QTY = UT.CONV.MILL(CK.QTY)
             CK.QTY = CK.QTY "R#7"
          END ELSE
             GOSUB GET.FMT
             CK.QTY = CK.QTY FMT
          END
          PRINT @(49,1):CK.QTY         "R#7":UM:TAG.OH/PER "R#7":UM

          CK.QTY = STK.CMTD/PER
          CK.SZ  = 7
          *** If greater than or equal to 1,000,000 convert to X.XX mil.
          IF CK.QTY > 999999 OR (CK.QTY # '' AND CK.QTY < -999999) THEN
             CK.QTY = UT.CONV.MILL(CK.QTY)
             CK.QTY = CK.QTY "R#7"
          END ELSE
             GOSUB GET.FMT
             CK.QYT = CK.QTY FMT
          END
          PRINT @(49,2):CK.QTY         "R#7":UM:TAG.CMTD/PER "R#7":UM

          CK.QTY = STK.PO/PER
          CK.SZ  = 7
          IF CK.QTY > 999999 OR (CK.QTY # '' AND CK.QTY < -999999) THEN
             CK.QTY = UT.CONV.MILL(CK.QTY)
             CK.QTY = CK.QTY "R#7"
          END ELSE
             GOSUB GET.FMT
             CK.QYT = CK.QTY FMT
          END
          PRINT @(49,3):CK.QTY         "R#7":UM:TAG.PO/PER "R#7":UM

          CK.QTY = STK.XFER/PER
          CK.SZ  = 7
          IF CK.QTY > 999999 OR (CK.QTY # '' AND CK.QTY < -999999) THEN
             CK.QTY = UT.CONV.MILL(CK.QTY)
             CK.QTY = CK.QTY "R#7"
          END ELSE
             GOSUB GET.FMT
             CK.QYT = CK.QTY FMT
          END
          PRINT @(49,4):CK.QTY         "R#7":UM:TAG.XFER/PER "R#7":UM

          CK.QTY = STK.WO/PER
          CK.SZ  = 7
          IF CK.QTY > 999999 OR (CK.QTY # '' AND CK.QTY < -999999) THEN
             CK.QTY = UT.CONV.MILL(CK.QTY)
             CK.QTY = CK.QTY "R#7"
          END ELSE
             GOSUB GET.FMT
             CK.QYT = CK.QTY FMT
          END
          PRINT @(49,5):CK.QTY         "R#7":UM:TAG.WO/PER   "R#7":UM

IN$$2:    INPR = STK.INPR+TAG.INPR
          IF INPR THEN
             PRINT @(74,1):BLINK$:INPR/PER         "R#5":NORM$
          END ELSE PRINT @(74,1):0                 "R#5"

          CALC.NCMTD = NCMTD/PER
          *** If greater than or equal to 1,000,000 convert to X.XX mil.
          IF CALC.NCMTD > 999999 OR (CALC.NCMTD # '' AND CALC.NCMTD < -999999) THEN
             CALC.NCMTD = UT.CONV.MILL(CALC.NCMTD)
          END

          PRINT @(74,2):CALC.NCMTD                  "R#5"
          PRINT @(74,3):ON.REVW/PER                 "R#5"
          PRINT @(74,4):ON.BID/PER                  "R#5"
          RETURN
*-------------------------------------------------------------------------*
NET.COMMT:* get the total network commitments
          NCMTD = STK.CMTD

*** If this is a whse branch then we should show priority for ALL brs net
          GET.PCGID PCGID,PRD(18),PRD(12)
          WHSE.FOR.ME WHSE,BR,PCGID
          IF WHSE = BR THEN
             WHSE.BRCHS = WHSE.LIST(WHSE,PCGID)
             WHSE.BRCHS = WHSE.BRCHS<1>
          END ELSE
             RETURN
          END

*** Set a list of priorities for all network branches.
          GOSUB SET.PRIS

*** Loop through all of the ids and put them in order of priority.
          MORE.DATA = (IDS.TMP#'')
          LOOP UNTIL NOT(MORE.DATA)

             REMOVE ID  FROM IDS.TMP  SETTING MORE.DATA
             REMOVE QTY FROM QTYS.TMP SETTING X
             REMOVE SBR FROM BRS.TMP  SETTING Y
             IF SBR = '' THEN SBR = WHSE

*** Add in the commited for ALL network branches if on the mother branch
             IF SBR # BR AND FIELD(ID,'~',3)[1,1] = 'S' THEN
                IF INDEX(STK.TYPES.AVL$,FIELD(ID,'~',6)[1,1],1) THEN
                   NCMTD += -QTY
                END
             END
          REPEAT

          RETURN
*-------------------------------------------------------------------------*
GET.FMT:  *
          IF INDEX (CK.QTY,'.',1) THEN
             XX = LEN(FIELD(CK.QTY,'.',1))
             BEGIN CASE
             CASE XX < CK.SZ-2       ; FMT = "R2#":CK.SZ
             CASE XX = CK.SZ-2       ; FMT = "R1#":CK.SZ
             CASE OTHERWISE          ; FMT = "R0#":CK.SZ
             END CASE
          END ELSE FMT = "R#":CK.SZ

          RETURN
*-------------------------------------------------------------------------*
SUBS:    ON OPTION GOTO SHOW.ONLY, VIEW.ORD, VIEW.LOCS, CHNG.BR, INV.INQ, HIST.LEDGER, CHG.VIEW, VLOG
*-------------------------------------------------------------------------*
VIEW.ORD: GID = FIELD(SEL.IDS<LINE>,'~',5)
          OID = FIELD(SEL.IDS<LINE>,'~',3)
          READV GIDS FROM LEDFILE,OID,12 ELSE GIDS = ''
          LOCATE GID IN GIDS<1> SETTING GEN ELSE PRINT BELL:; RETURN
          VIEW.ONLY = YES
          VIEW.EDIT.LED OID,GEN:VM:PN,VIEW.ONLY,1
          RETURN
*-------------------------------------------------------------------------*
VIEW.LOCS:PRD.LOCATION.MAINT PN:AM:BR:AM:1
          VSCROLL.SET 1
          RETURN
*-------------------------------------------------------------------------*
INV.INQ:  IF NOT(SUPR.AVAILS) THEN
             INV.INQ PN,BR
          END
          RETURN
*-------------------------------------------------------------------------*
CHNG.BR:  *** if it's already in trying to change the branch, don't let the
          *** in this routine again.
          IF IN.BR.CHANGE THEN
             RETURN
          END
          IN.BR.CHANGE = YES
GET.BR:   INP.BR 41,0,4,BR
          IF QUIT THEN RETURN TO FINISH
          GOSUB SORT.DATE
          IN.BR.CHANGE = NO
          RETURN TO REDISP
*-------------------------------------------------------------------------*
HIST.LEDGER: *
          INV.HISTORY.LEDGER PN,,BR
          RETURN
*-------------------------------------------------------------------------*
PRIORITY: GOSUB SORT.PRI
          SHOW.PRI = YES
          VCLR 1
          RETURN TO REDISP
*-------------------------------------------------------------------------*
SORT.PRI: IF PN#'' AND BR#'' THEN
             PRDD.BR.GET BR,PN
          END ELSE
             IDS  = ''
             QTYS = ''
             RETURN
          END

*** If this is a whse branch then we should show priority for ALL brs net
          GET.PCGID PCGID,PRD(18),PRD(12)
          WHSE.FOR.ME WHSE,BR,PCGID
          IF WHSE = BR THEN
             WHSE.BRCHS = WHSE.LIST(WHSE,PCGID)
             WHSE.BRCHS = WHSE.BRCHS<1>
          END ELSE
             WHSE.BRCHS = BR
          END

          PLENTY.DATE = DATE.NEXT.REC(PN,BR)
          GET.ONHAND PRDD.BR(1),PRDD.BR(8),STK.LVL

*** Set a list of priorities for all network branches.
          GOSUB SET.PRIS

*** Initialize the variables.
          PO.IDS  = ''
          PO.QTYS = ''
          PO.BRS  = ''
          IDS     = ''
          QTYS    = ''
          SBRS    = ''
          PY.IDS  = ''
          PY.QTYS = ''
          PY.BRS  = ''
*** Loop through all of the ids and put them in order of priority.
          MORE.DATA = (IDS.TMP#'')
          LOOP UNTIL NOT(MORE.DATA)

             REMOVE ID  FROM IDS.TMP  SETTING MORE.DATA
             REMOVE QTY FROM QTYS.TMP SETTING X
             REMOVE SBR FROM BRS.TMP  SETTING Y
             IF SBR = '' THEN SBR = WHSE

             IF QTY > 0 THEN
                LOCATE ID IN PO.IDS BY 'AL' SETTING POS ELSE NULL
                PO.IDS  = INSERT(PO.IDS,POS;ID)
                PO.QTYS = INSERT(PO.QTYS,POS;QTY)
                PO.BRS  = INSERT(PO.BRS,POS;SBR)
             END ELSE
                SHP.DT    = FIELD(ID,'~',2)+0
                ORD.STAT  = FIELD(ID,'~',9)
                THIS.OID  = FIELD(ID,'~',3)
                THIS.MODE = THIS.OID[1,1]

                * Check for cuttable products
                CUT.WORK  = FIELD(ID,'~',10)
                TAG.CHK   = FIELD(ID,'~',6)
                CWRK.CSLS = (CUT.WORK='CUT' AND THIS.MODE='W' AND TAG.CHK#'T')

                *** Check the order stat and adjust to the correct dt
                STAT.OK = ORD.STAT#'W' AND ORD.STAT#'S' AND ORD.STAT#'D'

                *** Only want to exclude the Plenty Date if the Product is
                *** not a Delete Status Product
                READV PRD.STAT FROM PRDFILE,PN,3 ELSE PRD.STAT = ""
                IF PRD.STAT # "4" THEN
                   IF EXC.FUT.SOE$ THEN STAT.OK = NO
                END

                BEGIN CASE
                CASE CWRK.CSLS AND STAT.OK
                   IF SBR # BR AND BR # WHSE THEN
                      SHP.DT = PLENTY.DATE
                   END ELSE
                      SHP.DT = DATE()
                   END
                CASE THIS.MODE = 'S' AND STAT.OK
                   IF SBR # BR AND BR # WHSE THEN
                      SHP.DT = PLENTY.DATE
                   END ELSE
                      SHP.DT = DATE()
                   END
                CASE THIS.MODE = 'S' AND NOT(STAT.OK) AND ORD.STAT#'D'
                   SHP.DT = SHP.DT
                   IF SBR # BR AND BR # WHSE THEN
                      IF SHP.DT < PLENTY.DATE THEN SHP.DT = PLENTY.DATE
                   END
                CASE QTY < 0 AND SBR # BR AND BR # WHSE
                   IF SHP.DT < PLENTY.DATE THEN SHP.DT = PLENTY.DATE
                END CASE
                IF SHP.DT >= PLENTY.DATE THEN
                   PY.IDS<-1>  = ID
                   PY.QTYS<-1> = QTY
                   PY.BRS<-1>  = SBR
                END ELSE
                   IDS<-1>  = ID
                   QTYS<-1> = QTY
                   SBRS<-1> = SBR
                END
             END
          REPEAT

*** Add in the later ids. (Past the plenty date)
          IF PY.IDS # '' THEN
             IDS<-1>  = PY.IDS
             QTYS<-1> = PY.QTYS
             SBRS<-1> = PY.BRS
          END

*** Put in the PO ids in order of priority.
          ID.CT = DCOUNT(IDS,AM)
          FOR J = 1 TO ID.CT UNTIL PO.IDS = ''
             STK.LVL += QTYS<J>
             IF STK.LVL < 0 THEN
                LOOP UNTIL PO.IDS = '' OR STK.LVL >=0
                   ID = PO.IDS<1>
                   QTY = PO.QTYS<1>
                   PBR = PO.BRS<1>
                   PO.IDS  = DELETE(PO.IDS,1)
                   PO.QTYS = DELETE(PO.QTYS,1)
                   PO.BRS  = DELETE(PO.BRS,1)
                   IDS  = INSERT(IDS,J;ID)
                   QTYS = INSERT(QTYS,J;QTY)
                   SBRS = INSERT(SBRS,J;PBR)
                   STK.LVL += QTY
                   J     += 1
                   ID.CT += 1
                REPEAT
             END
          NEXT J

*** If we still have some POs left over add them in to the list.
          IF PO.IDS#'' THEN
             IDS<-1>  = PO.IDS
             QTYS<-1> = PO.QTYS
             SBRS<-1> = PO.BRS
          END

          RETURN
*-------------------------------------------------------------------------*
SET.PRIS: * Set up a list of ids and needs for the priority list.
          OE.GET.PRIS IDS.TMP,QTYS.TMP,BRS.TMP,WHSE,PN,BR,PCGID
          RETURN
*-------------------------------------------------------------------------*
SORT.DATE: *
          IF PN#'' AND BR#'' THEN
             PRDD.BR.GET BR,PN
          END
          IDS  = ''
          QTYS = ''
          SIDS = ''
          IDS.TMP = PRDD.BR(ID.BASE)
          IF BID.MODE THEN
             QTY.TMP = PRDD.BR(6)
          END ELSE
             QTY.TMP = PRDD.BR(3)
          END

          MORE.DATA = (IDS.TMP#'')
          LOOP UNTIL NOT(MORE.DATA)
             REMOVE ID  FROM IDS.TMP SETTING MORE.DATA
             REMOVE QTY FROM QTY.TMP SETTING X
             ADD.IT = YES
             OID.TYPE      = FIELD(ID,'~',3)[1,1]
             TYPE          = FIELD(ID,'~',6)
             ORDSTAT       = FIELD(ID,'~',9)[1,1]
             *** Selection hot key stuff.
             LOCATE OID.TYPE IN OID.SELS<1> SETTING XX  ELSE ADD.IT = NO
             IF STK.SELS = 'N' AND ORDSTAT = 'R' THEN
                WK.TYPE = 'N'
             END ELSE
                WK.TYPE = TYPE[1,1]
             END
             IF WK.TYPE = 'S' AND LEN(TYPE)>1 THEN WK.TYPE = 'V'
             LOCATE WK.TYPE IN STK.SELS<1> SETTING XX ELSE ADD.IT = NO
             IF ADD.IT AND QTY+0#0 THEN
                SID = FIELD(ID,'~',2):'~':FIELD(ID,'~',3)
                LOCATE SID IN SIDS BY 'AL' SETTING POS ELSE NULL
                SIDS = INSERT(SIDS,POS;SID)
                IDS  = INSERT(IDS,POS;ID)
                QTYS = INSERT(QTYS,POS;QTY)
             END

          REPEAT

          RETURN
*-------------------------------------------------------------------------*
SHOW.ONLY:*
          SBRS = ''
          MENU.TABLE WORD,35,8,1,8,15,,,VALID.SELS,'Sales Types'
          IF QUIT THEN RETURN

          LOCATE WORD IN VALID.SELS<1> SETTING OPT ELSE GOTO SHOW.ONLY

          RESEL = YES

          ON OPT GOTO SHOW.ALL,SHOW.BIDS,SHOW.SALES,SHOW.PURCH,SHOW.TRANS,SHOW.ADJUST,SHOW.WOS,PRIORITY,SHOW.RNTLS

          RETURN
*-------------------------------------------------------------------------*
SHOW.ALL: *

          OID.SELS = ORIG.OID.SELS
          STK.SELS = ORIG.STK.SELS

*         TYPE.FILTER = ''
          BID.MODE    = NO
          ID.BASE     = 2
          GOSUB SORT.DATE
          VCLR 1
          RETURN TO REDISP
*-------------------------------------------------------------------------*
SHOW.BIDS:*
          MENU.TABLE WORD,35,8,1,11,15,,,SALES.SELS,'Stock Types'
          IF QUIT THEN QUIT=NO; GOTO SHOW.ONLY

          *** We'll check for Bid Quantities on all Order Types except for
          *** Work Orders, since we create Bid Quantities for Work Order
          *** Templates even though they can never technically be a Bid.
          OID.SELS = 'S,P,T,A'
          CONVERT ',' TO VM IN OID.SELS
          GOSUB SHOW.SET

          BID.MODE    = YES
          ID.BASE     = 5
          GOSUB SORT.DATE
          VCLR 1
          RETURN TO REDISP
*-------------------------------------------------------------------------*
SHOW.SALES:*
          MENU.TABLE WORD,35,8,1,11,15,,,SALES.SELS,'Stock Types'
          IF QUIT THEN QUIT=NO; GOTO SHOW.ONLY

          OID.SELS = 'S'
          GOSUB SHOW.SET

          BID.MODE    = NO
          ID.BASE     = 2
          GOSUB SORT.DATE
          VCLR 1
          RETURN TO REDISP
*-------------------------------------------------------------------------*
SHOW.PURCH:*
          MENU.TABLE WORD,35,8,1,9,15,,,PURCH.SELS,'Stock Types'
          IF QUIT THEN QUIT=NO; GOTO SHOW.ONLY

          OID.SELS = 'P'
          GOSUB SHOW.SET

          BID.MODE    = NO
          ID.BASE     = 2
          GOSUB SORT.DATE
          VCLR 1
          RETURN TO REDISP
*-------------------------------------------------------------------------*
SHOW.TRANS:*
          MENU.TABLE WORD,35,8,1,8,15,,,TRANS.SELS,'Stock Types'
          IF QUIT THEN QUIT=NO; GOTO SHOW.ONLY

          OID.SELS = 'T'
          GOSUB SHOW.SET

          BID.MODE    = NO
          ID.BASE     = 2
          GOSUB SORT.DATE
          VCLR 1
          RETURN TO REDISP
*-------------------------------------------------------------------------*
SHOW.RNTLS:*** Only show Rentals
          MENU.TABLE WORD,35,8,1,8,15,,,RNTLS.SELS,'Stock Types'
          IF QUIT THEN QUIT=NO; GOTO SHOW.ONLY


          OID.SELS     = 'R'
          GOSUB SHOW.SET

          BID.MODE    = NO
          ID.BASE     = 2
          GOSUB SORT.DATE
          VCLR 1

          RETURN TO REDISP
*-------------------------------------------------------------------------*
SHOW.ADJUST:* Only xfers
          OID.SELS = 'A'
          STK.SELS = ORIG.STK.SELS

          BID.MODE    = NO
          ID.BASE     = 2
          GOSUB SORT.DATE
          VCLR 1
          RETURN TO REDISP
*-------------------------------------------------------------------------*
SHOW.WOS: ** Only show work orders
          OID.SELS = 'W'
          STK.SELS = ORIG.STK.SELS

          BID.MODE    = NO
          ID.BASE     = 2
          GOSUB SORT.DATE
          VCLR 1
          RETURN TO REDISP
*-------------------------------------------------------------------------*
SHOW.SET: *
          BEGIN CASE
          CASE WORD='All'
             STK.SELS     = ORIG.STK.SELS
          CASE WORD='Directs'
             STK.SELS     = 'D'
          CASE WORD='Stock'
             STK.SELS     = 'S'
          CASE WORD='Defective'
             STK.SELS     = 'F'
          CASE WORD='Over Shipment'
             STK.SELS     = 'O'
          CASE WORD='Review'
             STK.SELS     = 'R'
          CASE WORD='Display'
             STK.SELS     = 'L'
          CASE WORD='Tagged'
             STK.SELS     = 'T':VM:'P'
          CASE WORD='Procure'
             STK.SELS     = 'P'
          CASE WORD='Except'
             STK.SELS     = 'E'
          CASE WORD='Remnant'
             STK.SELS     = 'M'
          CASE WORD='VendCnsgn'
             STK.SELS     = 'V'
          CASE WORD='CustCnsgn'
             STK.SELS     = 'C'
          CASE WORD='Reserve'
             STK.SELS     = 'N'
          CASE OTHERWISE
             *** This is the All case.
             OID.SELS     = ORIG.OID.SELS
             STK.SELS     = ORIG.STK.SELS
          END CASE
          RETURN
*-------------------------------------------------------------------------*
INIT:     *
          *** Initialize the selection data.
          VALID.SELS = 'All,Bids,Sales,Purchases,Transfers,Adjustments,Work Orders,Priority,Rentals'
          SALES.SELS = 'All,Stock,Directs,Tagged,Defective,Review,Over Shipment,Display,Except,Remnant,Procure,CustCnsgn,Reserve'
          PURCH.SELS = 'All,Stock,Directs,Tagged,Defective,Review,Over Shipment,Display,Procure,VendCnsgn'
          TRANS.SELS = 'All,Stock,Tagged,Defective,Review,Overship,Display,Procure'
          RNTLS.SELS = 'All,Stock,Tagged,Defective,Review,Overship,Display,Procure'


          OID.SELS = 'S,P,T,A,W,R'
          STK.SELS = 'S,F,O,R,L,T,D,P,E,M,V,C,N'

          CONVERT ',' TO VM IN VALID.SELS
          CONVERT ',' TO VM IN SALES.SELS
          CONVERT ',' TO VM IN PURCH.SELS
          CONVERT ',' TO VM IN TRANS.SELS
          CONVERT ',' TO VM IN OID.SELS
          CONVERT ',' TO VM IN STK.SELS


          ORIG.OID.SELS = OID.SELS
          ORIG.STK.SELS = STK.SELS

          GET.SCREEN.INFO 'PRODUCT.LEDGER',USER.ID,VIEW.NO
          IF NOT(VIEW.NO) THEN VIEW.NO = 1

          RETURN
*-------------------------------------------------------------------------*
CHG.VIEW: *** Change View
          IF VIEW.NO = 1 THEN
             VIEW.NO = 2
          END ELSE
             VIEW.NO = 1
          END

          GOSUB LOAD.VIEW
          GOSUB SORT.DATE
          VCLR 1

          RETURN TO REDISP
*-------------------------------------------------------------------------*
VLOG:     PRD.LOG.VIEW BR,PN

          RETURN
*-------------------------------------------------------------------------*
FINISH:   *** Finish
          SET.SCREEN.INFO 'PRODUCT.LEDGER',USER.ID,VIEW.NO
          WINDOW.CLOSE

          RETURN
*-------------------------------------------------------------------------*
!TSMITH~08/25/16~10:12
